Classification/Régionalisation

Application aux résultats des élections européennes de 2024 en France

Auteur·rice

Claude Grasland

Date de publication

2024-12-11

Mise en place : Télécharger le dossier exo_autocor.zip et décompressez le sur votre ordinateur. Puis créez un projet R avant d’executer le programme

Vous allez choisir une ou plusieurs régions voisines hors Ile-de-France (données imparfaites pour Paris)

“ALSACE-CHAMPAGNE-ARDENNE-LORRAINE”
“AQUITAINE-LIMOUSIN-POITOU-CHARENTES” “AUVERGNE-RHONE-ALPES”
“BOURGOGNE-FRANCHE-COMTE”
“BRETAGNE”
“CENTRE-VAL DE LOIRE”
“LANGUEDOC-ROUSSILLON-MIDI-PYRENEES” “NORD-PAS-DE-CALAIS-PICARDIE”
“NORMANDIE”
“PAYS DE LA LOIRE”
“PROVENCE-ALPES-COTE D’AZUR”

Recopiez leurs noms ci-dessous :

myreg <- c("LANGUEDOC-ROUSSILLON-MIDI-PYRENEES")

A. CLASSIFCATION A L’ECHELLE REGIONALE

On commence par des méthodes statistiques classiques (ACP et CAH) afin de situer notre région par rapport aux autres, de voir quels partis y sont les plus importants ou les plus faibles, et de voir quelles sont les régions qui lui ressemblent le plus ou le moins.

N.B. On a choisi d’utiliser une ACP sur variables standardisées, ce qui donne le même poids à tous les partis. On aurait pu évidemment faire un choix différent…

Tableau de données

### Données
don<-readRDS("data/elect2024/don_reg.RDS")
code<-as.factor(don$nom_reg)
levels(code)<-c("ACAL", "AQUI","AURA","BOFC","BRET","CVDL","IDF","OCCI","NOPI","NORM","PDL","PACA")
tab<-as.matrix(don[,3:12])
rownames(tab)<-code
kable(tab, digits=1, caption = "Résultats des européeennes 2024 par région")

Résultats des européeennes 2024 par région
	Aubry	Bardella	Bellamy	Deffontaines	Glucksman	Hayer	Lassale	Marechal	Toussaint	Autres
ACAL	7.6	38.3	7.6	1.6	10.8	14.4	1.9	5.5	4.1	8.2
AQUI	6.8	30.9	6.5	2.9	16.0	14.8	4.7	5.0	5.3	7.2
AURA	9.5	30.9	8.0	2.3	13.8	14.2	2.1	5.6	6.2	7.4
BOFC	7.0	37.1	7.5	2.3	12.2	13.8	2.9	5.3	4.4	7.6
BRET	7.1	25.6	7.5	2.6	18.4	17.4	2.3	4.2	7.3	7.6
CVDL	7.4	34.9	7.5	2.6	12.5	15.1	2.6	5.4	4.4	7.5
IDF	18.6	18.8	8.8	2.0	15.8	15.5	0.8	5.7	7.0	7.1
OCCI	9.0	33.7	5.5	2.7	15.5	12.2	3.8	5.5	5.1	7.0
NOPI	8.4	42.4	6.1	3.1	9.0	12.9	2.5	4.6	3.6	7.4
NORM	6.9	35.3	6.9	2.8	13.3	15.7	2.7	4.6	4.4	7.3
PDL	7.1	27.6	7.9	2.1	16.1	17.9	2.1	4.7	7.1	7.3
PACA	9.7	38.6	6.4	2.1	10.5	12.3	1.5	7.7	4.2	6.9

Analyse en composantes principales

On utilise la procédure PCA de FactoMineR que la plupart des étudiants connaissent :

acp<-PCA(tab,  scale.unit = T)

summary(acp)


Call:
PCA(X = tab, scale.unit = T) 


Eigenvalues
                       Dim.1   Dim.2   Dim.3   Dim.4   Dim.5   Dim.6   Dim.7
Variance               4.197   2.616   1.854   0.615   0.380   0.180   0.088
% of var.             41.969  26.158  18.538   6.152   3.805   1.799   0.883
Cumulative % of var.  41.969  68.127  86.665  92.817  96.622  98.421  99.303
                       Dim.8   Dim.9  Dim.10
Variance               0.051   0.018   0.000
% of var.              0.512   0.185   0.000
Cumulative % of var.  99.815 100.000 100.000

Individuals (the 10 first)
                 Dist    Dim.1    ctr   cos2    Dim.2    ctr   cos2    Dim.3
ACAL         |  3.751 | -0.631  0.790  0.028 | -1.970 12.365  0.276 |  2.932
AQUI         |  2.966 | -0.673  0.899  0.051 |  2.506 20.001  0.714 | -1.003
AURA         |  1.378 |  0.911  1.648  0.437 | -0.631  1.267  0.209 | -0.075
BOFC         |  1.637 | -0.989  1.943  0.365 | -0.325  0.337  0.039 |  1.002
BRET         |  3.507 |  2.648 13.928  0.570 |  2.033 13.161  0.336 |  0.680
CVDL         |  1.176 | -0.579  0.666  0.242 |  0.013  0.001  0.000 |  0.697
IDF          |  5.120 |  4.138 34.003  0.653 | -2.230 15.836  0.190 | -1.610
OCCI         |  3.134 | -1.618  5.199  0.267 |  1.111  3.930  0.126 | -2.107
NOPI         |  3.620 | -3.037 18.310  0.704 |  0.276  0.242  0.006 |  0.332
NORM         |  1.805 | -0.731  1.062  0.164 |  1.196  4.559  0.439 |  0.236
                ctr   cos2  
ACAL         38.653  0.611 |
AQUI          4.526  0.114 |
AURA          0.025  0.003 |
BOFC          4.510  0.375 |
BRET          2.081  0.038 |
CVDL          2.181  0.351 |
IDF          11.648  0.099 |
OCCI         19.947  0.452 |
NOPI          0.495  0.008 |
NORM          0.250  0.017 |

Variables
                Dim.1    ctr   cos2    Dim.2    ctr   cos2    Dim.3    ctr
Aubry        |  0.483  5.561  0.233 | -0.561 12.032  0.315 | -0.487 12.805
Bardella     | -0.938 20.984  0.881 | -0.113  0.486  0.013 |  0.293  4.631
Bellamy      |  0.818 15.932  0.669 | -0.326  4.062  0.106 |  0.336  6.086
Deffontaines | -0.414  4.082  0.171 |  0.728 20.278  0.530 | -0.300  4.862
Glucksman    |  0.734 12.835  0.539 |  0.547 11.432  0.299 | -0.263  3.744
Hayer        |  0.771 14.152  0.594 |  0.377  5.424  0.142 |  0.369  7.328
Lassale      | -0.453  4.882  0.205 |  0.762 22.212  0.581 | -0.141  1.077
Marechal     | -0.248  1.470  0.062 | -0.759 22.019  0.576 | -0.417  9.363
Toussaint    |  0.918 20.091  0.843 |  0.218  1.810  0.047 | -0.183  1.799
Autres       |  0.022  0.012  0.000 | -0.080  0.244  0.006 |  0.946 48.306
               cos2  
Aubry         0.237 |
Bardella      0.086 |
Bellamy       0.113 |
Deffontaines  0.090 |
Glucksman     0.069 |
Hayer         0.136 |
Lassale       0.020 |
Marechal      0.174 |
Toussaint     0.033 |
Autres        0.896 |

Commentaires :
- L’axe 1 résume … % de l’information et oppose les régons … aux régions …
- L’axe 2 résume … % de l’information et oppose les régons … aux régions …
- La position de notre région dans le plan factoriel montre …

Classification ascendante hiérarchique

Vous allez ensuite classer les régions en choisissant le nombre de classes adapté (ici 2)

cah<-HCPC(acp, nb.clust = 2, graph=F)
plot(cah,choice = "tree")

catdes(cah$data.clust,num.var = 11)


Link between the cluster variable and the quantitative variables
================================================================
               Eta2      P-value
Toussaint 0.8488306 2.078509e-05
Bardella  0.6496145 1.547239e-03
Bellamy   0.4853048 1.182744e-02
Hayer     0.4123888 2.434807e-02
Glucksman 0.3982128 2.777675e-02

Description of each cluster by quantitative variables
=====================================================
$`1`
             v.test Mean in category Overall mean sd in category Overall sd
Bardella   2.673155        36.421230    32.856784      3.2746565  6.2543056
Glucksman -2.092926        12.479180    13.668880      2.2551663  2.6662135
Hayer     -2.129854        13.884500    14.674870      1.2455553  1.7405712
Bellamy   -2.310487         6.736277     7.178515      0.7116798  0.8977669
Toussaint -3.055673         4.460683     5.271143      0.5157216  1.2440455
              p.value
Bardella  0.007514144
Glucksman 0.036355724
Hayer     0.033183685
Bellamy   0.020861182
Toussaint 0.002245561

$`2`
             v.test Mean in category Overall mean sd in category Overall sd
Toussaint  3.055673         6.892064     5.271143      0.4122303  1.2440455
Bellamy    2.310487         8.062990     7.178515      0.4811800  0.8977669
Hayer      2.129854        16.255609    14.674870      1.4959422  1.7405712
Glucksman  2.092926        16.048281    13.668880      1.6316290  2.6662135
Bardella  -2.673155        25.727894    32.856784      4.4351597  6.2543056
              p.value
Toussaint 0.002245561
Bellamy   0.020861182
Hayer     0.033183685
Glucksman 0.036355724
Bardella  0.007514144

Commentaire : La classification met en évidence deux grands types de région.
- La classe 1 ( …) correspond à des régions qui ont significativement plus voté pour la.les listes … et moins voté pour la.les listes …
- La classe 2 (…) correspond à des régions qui ont significativement plus voté pour la.les listes … et moins voté pour la.les listes …
- notre région appartient à la classe …

Classification ascendante hiérarchique

cah<-HCPC(acp, nb.clust = 4, graph=F)
plot(cah,choice = "tree")

catdes(cah$data.clust,num.var = 11)


Link between the cluster variable and the quantitative variables
================================================================
               Eta2      P-value
Aubry     0.9124509 0.0001394206
Lassale   0.8415963 0.0014477425
Bardella  0.8222734 0.0022737740
Toussaint 0.7840109 0.0048701089
Glucksman 0.7619830 0.0071046385
Hayer     0.6672698 0.0258211127
Bellamy   0.6437010 0.0335083603

Description of each cluster by quantitative variables
=====================================================
$`1`
           v.test Mean in category Overall mean sd in category Overall sd
Lassale  2.693611         4.244989     2.479399      0.4051319  0.9722238
Bellamy -1.972241         5.984768     7.178515      0.5017091  0.8977669
            p.value
Lassale 0.007068261
Bellamy 0.048582150

$`2`
             v.test Mean in category Overall mean sd in category Overall sd
Bardella   2.479272        36.808111    32.856784      3.3283332   6.254306
Toussaint -2.458332         4.491822     5.271143      0.7542412   1.244045
Glucksman -2.830897        11.745529    13.668880      1.5835472   2.666213
              p.value
Bardella  0.013165079
Toussaint 0.013958414
Glucksman 0.004641762

$`3`
            v.test Mean in category Overall mean sd in category Overall sd
Hayer     2.550464        17.667821    14.674870     0.25732059   1.740571
Toussaint 2.293669         7.194924     5.271143     0.08772127   1.244045
Glucksman 2.012458        17.286396    13.668880     1.15061744   2.666213
             p.value
Hayer     0.01075797
Toussaint 0.02180951
Glucksman 0.04417165

$`4`
            v.test Mean in category Overall mean sd in category Overall sd
Aubry     3.144405         18.56756      8.75000              0   3.122231
Bardella -2.249315         18.78888     32.85678              0   6.254306
             p.value
Aubry    0.001664248
Bardella 0.024492492

Commentaire : Ma région …

B. CLASSIFICATION A L’ECHELLE DEPARTEMENTALE

Nous allons maintenant reprendre l’analyse de la France entière mais au niveau des départements afin de savoir si notre région forme un ensemble homogène ou si les départements qui la compose font partie de classes différentes.

Préparation des données

On effectue cette fois-ci une jointure entre les données départementales et le fonds de carte correspondant afin de pouvoir produire des cartes.

### Fonds de carte région (pour habillage)
mapreg<-st_read("data/elect2024/map_reg.shp", quiet=T) %>%
      st_transform(2154)

### Fonds de carte dept
map<-st_read("data/elect2024/map_dept.shp", quiet=T) %>%
      select(code=code_dpt,  geometry) %>%
      st_transform(2154)

### Données
don<-readRDS("data/elect2024/don_dept.RDS") %>%
          select(code=code_dpt, nom=nom_dpt, 5:14)

### Jointure
mapdon<-left_join(map[,1],don)

Cartographie rapide

On visualise rapidement les scores de chaque parti pour avoir une idée de leur répartition. Il est évidemment possible de faire des cartes plus belles !

plot(mapdon[4:13])

Analyse en composantes principales

On utilise la même procédure que pour les régions

tab<-mapdon[,4:13] %>% st_drop_geometry()
row.names(tab)<- mapdon$code
acp<-PCA(tab,  scale.unit = T)

summary(acp)


Call:
PCA(X = tab, scale.unit = T) 


Eigenvalues
                       Dim.1   Dim.2   Dim.3   Dim.4   Dim.5   Dim.6   Dim.7
Variance               3.270   2.240   1.496   1.060   0.745   0.483   0.372
% of var.             32.696  22.401  14.962  10.604   7.452   4.827   3.723
Cumulative % of var.  32.696  55.097  70.060  80.664  88.115  92.943  96.666
                       Dim.8   Dim.9  Dim.10
Variance               0.261   0.073   0.000
% of var.              2.607   0.728   0.000
Cumulative % of var.  99.272 100.000 100.000

Individuals (the 10 first)
                 Dist    Dim.1    ctr   cos2    Dim.2    ctr   cos2    Dim.3
01           |  1.707 | -0.150  0.007  0.008 | -1.602  1.219  0.880 |  0.310
02           |  3.793 | -3.324  3.594  0.768 | -0.814  0.314  0.046 | -0.023
03           |  3.855 | -1.729  0.972  0.201 |  1.607  1.227  0.174 |  0.752
04           |  2.263 | -0.859  0.240  0.144 |  0.563  0.150  0.062 | -1.460
05           |  2.129 |  1.026  0.343  0.232 |  0.382  0.069  0.032 | -0.598
06           |  5.147 | -1.197  0.466  0.054 | -3.900  7.225  0.574 |  0.562
07           |  1.276 | -0.356  0.041  0.078 |  0.353  0.059  0.077 | -0.613
08           |  2.915 | -2.607  2.211  0.800 | -0.709  0.239  0.059 |  0.376
09           |  4.097 | -0.631  0.130  0.024 |  2.969  4.187  0.525 | -1.999
10           |  3.138 | -1.926  1.206  0.376 | -1.711  1.390  0.297 |  1.034
                ctr   cos2  
01            0.069  0.033 |
02            0.000  0.000 |
03            0.402  0.038 |
04            1.515  0.416 |
05            0.254  0.079 |
06            0.224  0.012 |
07            0.267  0.231 |
08            0.100  0.017 |
09            2.841  0.238 |
10            0.760  0.108 |

Variables
                Dim.1    ctr   cos2    Dim.2    ctr   cos2    Dim.3    ctr
Aubry        |  0.458  6.417  0.210 | -0.180  1.439  0.032 | -0.751 37.734
Bardella     | -0.941 27.083  0.886 | -0.187  1.557  0.035 |  0.105  0.743
Bellamy      |  0.379  4.397  0.144 | -0.343  5.237  0.117 |  0.637 27.137
Deffontaines | -0.279  2.384  0.078 |  0.773 26.707  0.598 | -0.132  1.172
Glucksman    |  0.735 16.508  0.540 |  0.577 14.837  0.332 |  0.020  0.026
Hayer        |  0.650 12.921  0.422 | -0.119  0.637  0.014 |  0.581 22.564
Lassale      | -0.311  2.965  0.097 |  0.761 25.839  0.579 |  0.266  4.732
Marechal     | -0.185  1.046  0.034 | -0.611 16.681  0.374 |  0.057  0.214
Toussaint    |  0.925 26.178  0.856 |  0.057  0.146  0.003 | -0.129  1.105
Autres       |  0.057  0.101  0.003 | -0.394  6.921  0.155 | -0.262  4.573
               cos2  
Aubry         0.565 |
Bardella      0.011 |
Bellamy       0.406 |
Deffontaines  0.018 |
Glucksman     0.000 |
Hayer         0.338 |
Lassale       0.071 |
Marechal      0.003 |
Toussaint     0.017 |
Autres        0.068 |

Commentaires : A priori ils sont assez vosins de ceux déja vus pour les régions
- L’axe 1 résume … % de l’information et oppose les régons … aux régions …
- L’axe 2 résume … % de l’information et oppose les régons … aux régions …

On va cette fois-ci cartographier les axes factoriels afin de mieux comprendre les oppositions spatiales qu’ils mettent en évidence et pour situer les départements de notre région :

mapdon$axe1<-acp$ind$coord[,1]
mapdon$axe2<-acp$ind$coord[,2]

par(mfrow=c(1,2))
mypal<- brewer.pal(6, "RdYlBu")
mybreaks<-c(-10,-2,-1,0,1,2,10)

mf_map(mapdon, type="choro", var="axe1", pal=mypal, breaks=mybreaks, lwd=0.1, border="white")
mf_map(mapreg, type="base", col=NA, lwd=1, add=T)
mf_layout("Axe1 (33%): Ecolo+Bobos Vs Prolos+Fachos ?", frame=T)

mf_map(mapdon, type="choro", var="axe2",pal=mypal, breaks=mybreaks, lwd=0.1, border="white")
mf_map(mapreg, type="base", col=NA, lwd=1, add=T)
mf_layout("Axe2 (22%) : Gauche Vs Droite ?", frame=T)

Classification ascendante hiérarchique

Vous allez ensuite classer les départements en choisissant le nombre de classes adapté (j’ai pris 4 mais on peut faire un choix différent)

cah<-HCPC(acp, nb.clust = 3, graph=F)
plot(cah,choice = "tree")

catdes(cah$data.clust,num.var = 11)


Link between the cluster variable and the quantitative variables
================================================================
                  Eta2      P-value
Bardella     0.5971187 1.085317e-18
Toussaint    0.5868101 3.426205e-18
Lassale      0.5335313 8.539308e-16
Glucksman    0.5226421 2.440101e-15
Deffontaines 0.4185499 1.928936e-11
Hayer        0.3603235 1.483196e-09
Marechal     0.1478857 6.881012e-04
Aubry        0.1339412 1.440145e-03

Description of each cluster by quantitative variables
=====================================================
$`1`
             v.test Mean in category Overall mean sd in category Overall sd
Bardella   6.976394        39.726945    33.884648       4.054609  7.4155479
Marechal   3.596471         5.686227     5.337026       0.932885  0.8597853
Lassale   -1.988401         2.673761     3.079946       1.039553  1.8088826
Hayer     -4.164846        12.961003    14.112831       1.396425  2.4489474
Toussaint -5.705205         3.891450     4.895653       0.817938  1.5586223
Glucksman -6.971136        11.081598    13.434096       1.736401  2.9882460
               p.value
Bardella  3.028535e-12
Marechal  3.225641e-04
Lassale   4.676734e-02
Hayer     3.115632e-05
Toussaint 1.162031e-08
Glucksman 3.143924e-12

$`2`
                v.test Mean in category Overall mean sd in category Overall sd
Lassale       6.911539         5.655660     3.079946      1.8822244  1.8088826
Deffontaines  6.132592         3.516519     2.529523      0.7656561  0.7811937
Glucksman     3.137765        15.365838    13.434096      1.8852301  2.9882460
Autres       -2.234648         7.043583     7.320773      0.4512943  0.6020832
Marechal     -2.464580         4.900464     5.337026      0.4063327  0.8597853
                  p.value
Lassale      4.794224e-12
Deffontaines 8.645878e-10
Glucksman    1.702416e-03
Autres       2.544049e-02
Marechal     1.371738e-02

$`3`
                v.test Mean in category Overall mean sd in category Overall sd
Toussaint     7.290583         6.535799     4.895653      1.3155696  1.5586223
Hayer         5.769028        16.152039    14.112831      2.7410936  2.4489474
Glucksman     4.669887        15.448294    13.434096      2.5218415  2.9882460
Aubry         3.450912        10.507913     8.283339      6.5710953  4.4661535
Bellamy       2.345550         7.665869     7.122164      1.6174986  1.6059764
Deffontaines -3.287260         2.158866     2.529523      0.4916698  0.7811937
Lassale      -3.766977         2.096427     3.079946      0.9632606  1.8088826
Bardella     -6.570856        26.851584    33.884648      6.0192932  7.4155479
                  p.value
Toussaint    3.086155e-13
Hayer        7.973011e-09
Glucksman    3.013658e-06
Aubry        5.586960e-04
Bellamy      1.899904e-02
Deffontaines 1.011672e-03
Lassale      1.652365e-04
Bardella     5.002687e-11

Commentaire : La classification met en évidence deux grands types de région.
- La classe 1 ( …)
- La classe 2 (…) .
- la classe 3 (…)
- …

On peut ensuite cartogaphier les classes correspondantes pour mieux voir la distribution spatiale. Cela suppose que l’on ait donné aux classes des noms suite à l’interprétation

mapdon$cah<-as.factor(cah$data.clust$clust)
levels(mapdon$cah)<-c("Classe 1 : Fachos ?", 
                      "Classe 2 = Gauchos ?",
                      "Classe 3 = Bobos ")


par(mfrow=c(1,1))

mf_map(mapdon, type="typo", var="cah", lwd=0.1, border="white", leg_title = "Classes")
mf_map(mapreg, type="base", col=NA, lwd=1, add=T)
mf_layout("Typologie en trois classes aux noms ...discutables !", frame=T,credits = "")

Commentaire : Les différentes classes recouvrent souvent des départements voisins mais elles neforment pas des régions puisque chaque classe se compose de plusieurs blocs départementaux séparés. Seule la classe 1 forme presque une région d’un seul bloc.

C. REGIONALISATION A L’ECHELLE DEPARTEMENTALE

Nous reprenons l’analyse précédente mais avec une légère modification puisque nous allons maintenant cherche à construire des régions et non pas des classes. Les critères utilisés sont les mêmes (distance euclidienne standardisée) mais le regroupement ne pourra s’opérer qu’entre départements voisins i.e. ayant une frontière commune. Il y a beaucoup de méthodes possibles de régionalisation mais on se limitera ici à la méthode SKATER vue en cours.

Préparation des données

la préparation des données est la même que précédemment

### Fonds de carte région (pour habillage)
mapreg<-st_read("data/elect2024/map_reg.shp", quiet=T) %>%
      st_transform(2154)

### Fonds de carte dept
map<-st_read("data/elect2024/map_dept.shp", quiet=T) %>%
      select(code=code_dpt,  geometry) %>%
      st_transform(2154)

### Données
don<-readRDS("data/elect2024/don_dept.RDS") %>%
          select(code=code_dpt, nom=nom_dpt, 5:14)

### Jointure
mapdon<-left_join(map[,1],don)

Calcul du graphe de contiguïté

On utilise la procédure poly2nb() du package spdep :

# Table de voisinage
map_nb<-spdep::poly2nb(mapdon,row.names = mapdon$code)

# Table de poids
map_nb_w<-nb2listw(map_nb)
summary(map_nb_w)

Characteristics of weights list object:
Neighbour list object:
Number of regions: 94 
Number of nonzero links: 474 
Percentage nonzero weights: 5.364418 
Average number of links: 5.042553 
Link number distribution:

 2  3  4  5  6  7  8 10 
 6 12 14 19 30 11  1  1 
6 least connected regions:
06 29 57 62 66 74 with 2 links
1 most connected region:
77 with 10 links

Weights style: W 
Weights constants summary:
   n   nn S0       S1       S2
W 94 8836 94 40.29206 383.9874

# Carte de voisinage
coo<-st_coordinates(st_centroid(mapdon))
mf_map(mapdon, type="base",col="lightyellow")
mf_layout("Carte des liens de voisinage", frame=T)
plot.nb(map_nb,coords = coo,add = T,col = "red",points = F)
mf_label(mapdon, var="code", col="blue",cex=0.6,halo = T, bg="white",r = 0.1)

Commentaire : On vérifie que le graphe est connexe et que chaque département a au moins un voisin. Certains départements situes aux extrémités du pays ont un seul voisin (ex. O6 Alpes Maritime ou 09 Finistère) tandis que d’autres ont jusqu’à 10 voisins (77 : Seine-et-Marne). Leurs possibilités de regroupement en région seront donc plus ou moins contraintes.

Calcul de la matrice de dissimilarité

Nous devons calculer la matrice de dissimilarité directement à partir du tableau des variables standardisées.

# choix des variables
tab<-mapdon[,4:13] %>% st_drop_geometry()
row.names(tab)<- mapdon$code

# standardisation
tabstd <-scale(tab)

# calcul des distances
matdis <- as.matrix(dist(tabstd, method="euclidean"))

# Extrait de la matrice
kable(matdis[c("06","83","92","78"),c("06","83","92","78")], digits=2, caption="Extrait de la matrice de dissimilarité")

Extrait de la matrice de dissimilarité
	06	83	92	78
06	0.00	1.91	6.86	5.03
83	1.91	0.00	7.90	6.13
92	6.86	7.90	0.00	2.08
78	5.03	6.13	2.08	0.00

Commentaire : Les Alpes Maritime (06) et le Var (83) ont des profils très proches (d = 1.91). Tout comme les Hauts-de-Seine (92) et les Yvelines (d= 2.08). Par contre les départements de chaque groupe sont très différents de ceux de l’autre groupe(d > 5), la plus forte différence étant observée ici entre les Hauts de Seine et le Var (d = 7.90)

Calcul de l’arbre couvrant minimal (minimum spanning tree)

On va ensuite utilise un algorithme pour déterminer l’arbre couvrant minimum, c’est-à-dire le graphe permettant de relier tous les départements les uns en l’autre en empruntant des chemins où les différences sont les plus faibles possibles.

map_nb<-poly2nb(mapdon)
lcosts <- nbcosts(map_nb,tabstd,method="euclidean",)
#summary(lcosts)
sim <- nb2listw(map_nb,lcosts,style="B")
#summary(sim)
mst <- mstree(sim)
class(mst)

[1] "mst"    "matrix"

size<-mst[,3]
size<-size/max(size)
mst[,3]<-0.5+4*size


y<-unlist(sim$neighbours)
w<-unlist(sim$weights)
x<-as.numeric(lapply(sim$neighbours, length))
n<-length(x)
xx<-NULL
for (i in 1:n) {
  z<-rep(i,x[i])
  xx<-c(xx,z)
}


q<-data.frame(xx,y,w)

ctr<-st_coordinates(st_centroid(mapdon))

mf_map(mapdon, type="base",col="lightyellow",lwd=0.2)
mf_map(mapreg, type="base", col=NA, lwd=1, add=T)
#segments(ctr[q[,1],1] ,ctr[q[,1],2], ctr[q[,2],1] ,ctr[q[,2],2],
#         col="gray", lwd=1+2*q$w, lty=2)
segments(ctr[mst[,1],1] ,ctr[mst[,1],2], ctr[mst[,2],1] ,ctr[mst[,2],2],
         col="red", lwd=mst[,3])

#points(x=(ctr[q[,1],1] +ctr[q[,2],1])/2,  y=(ctr[q[,1],2] +ctr[q[,2],2])/2,   pch=22, # bg="white", cex=3, col="black")
#text(  x=(ctr[q[,1],1] +ctr[q[,2],1])/2,  y=(ctr[q[,1],2] +ctr[q[,2],2])/2, #round(q$w,1), cex=0.7)
mf_label(mapdon, var="code", col="blue",cex=0.5,halo = T,bg = "white")
mf_layout("Arbre couvrant minimum du graphe de dissimilarité", frame=T)

Commentaire : Il est intéressant de voir que l’arbre couvrant minimum respecte plus ou moins bien les limites régionales. Certaines régions sont assez compactes tandis que d’autres sont plus écartelées. Qu’en est-il pour votre région ?

Régionalisation par la méthode SKATER

Cette méthode consiste à découper l’arbre couvrant minimal en plusieurs sous-arbres de façon à minimiser les différences intra-régionales et maximiser les différences inter-régionales. On ne sait pas a priori le nombre de régions qui sont nécessaire et on doit tatonner pour trouver le nombre de région permettant d’assurer un bon compromis entre efficacité (peu de régions rendent le résultat plus simple à interpréter) et homogénéité (beaucoup de régions permet d’assurer une plus grande homogénéité).

contig_w<-queen_weights(mapdon)
regio<-skater(6, contig_w, tab, scale_method = "standardize")


mapdon$regio<-as.factor(regio$Clusters)
don$regio<-as.factor(regio$Clusters)

mf_map(mapdon, type="typo",var="regio",leg_title = "Regionalisation", lwd=0.4, border="white")
mf_map(mapreg, type="base", col=NA, lwd=1, add=T)
segments(ctr[mst[,1],1] ,ctr[mst[,1],2], ctr[mst[,2],1] ,ctr[mst[,2],2],
         col="red", lwd=mst[,3])
#mstk<-mst[c(2:5,7:10),]
#segments(ctr[mstk[,1],1] ,ctr[mstk[,1],2], ctr[mstk[,2],1] ,ctr[mstk[,2],2],
#         col="red", lwd=1+2*mstk[,3])
#mf_label(mapdon, var="nom", col="black",cex=0.5,halo = T,bg = "white")
mf_layout("Régionalisation par la methode SKATER", frame=T)

Commentaire : Pour un nombre de classe donnée (ici on a choisi arbitrairement 6), la carte permet de voir à quel endroit on a découpé l’arbre couvrant minimum (ex. entre Hérault et Aude, entre Dordogne et Charentes, …). Puis ont peut examiner si une région administrative appartiennent à une seule région homogène (ex. Bourgogne-Franche Comté) ou à plusieurs (ex. Occitanie). On peut aussi trouver des cas ou une région administrative se sépare en deux régions homogènes qui lui sont propres comme dans le cas de l’Ile-de-France.

Par rapport à la classification, on remarque que beaucoup de départements métropolitains sont désormais fusionnés dans des ensembles plus vastes. Ainsi le Haut-Rhin (Strasbourg) se retrouve fusionnée avec la grande classe 1 caractérisée par le vote Bardella alors que son profil serait plutôt différent. Mais il n’y avaut aucune possibilité de regroupement avec des voisins similaires.

On oeut évaluer la qualité de la régionalisaiton en comparant la ressemblance moyenne de deux unités situes dans une même région et deux unités situées dans des régions différentes. Les résultats s’affichent comme suit

regio

$Clusters
 [1] 1 1 1 1 1 4 1 1 2 1 2 2 4 3 1 3 3 1 2 1 3 2 2 1 1 1 1 3 4 2 2 3 4 3 1 3 1 1
[39] 2 1 1 1 3 1 2 2 2 3 3 1 1 3 1 1 3 1 1 1 1 3 1 2 2 2 2 1 1 1 1 1 3 1 1 6 1 5
[77] 6 3 1 2 2 4 4 3 3 2 1 1 1 5 6 5 5 5

$`Total sum of squares`
[1] 930

$`Within-cluster sum of squares`
 [1] 30.52610 41.26855 57.77769 70.48488 44.70927 37.88487 33.26559 42.98798
 [9] 63.69268 74.08317

$`Total within-cluster sum of squares`
[1] 433.3192

$`The ratio of between to total sum of squares`
[1] 0.4659346

Commentaire : les résultats nous indiquent que la régionalisation résume environ 47% de la variance totale du tableau de données ce qui est évidemment moins que ce que l’on aurait obtenu avec une classification sans contraintes de contiguïté en 6 classes.

Profil de vote des régions issues de SKATER

Comme dans une classification, on peut analyser le profil de vote des régions obtenues

tabstd<-as.data.frame(tabstd)
tabstd$regions<-as.factor(regio$Clusters)

catdes(tabstd,num.var = 11)


Link between the cluster variable and the quantitative variables
================================================================
                  Eta2      P-value
Aubry        0.6717624 6.606041e-20
Lassale      0.6423055 2.716194e-18
Hayer        0.5926358 7.380970e-16
Bardella     0.5562521 2.905184e-14
Marechal     0.5377637 1.667482e-13
Glucksman    0.5192552 8.921106e-13
Bellamy      0.3787345 4.518475e-08
Toussaint    0.3151325 2.542470e-06
Deffontaines 0.2420981 1.524734e-04
Autres       0.2034068 1.076642e-03

Description of each cluster by quantitative variables
=====================================================
$`1`
             v.test Mean in category  Overall mean sd in category Overall sd
Bardella   4.856376        0.5455056  1.699660e-17      0.7283134  0.9946666
Autres     2.571012        0.2887959  1.597422e-16      1.0750407  0.9946666
Aubry     -1.995322       -0.2241300 -3.912355e-18      0.4505621  0.9946666
Lassale   -2.071134       -0.2326457 -5.321357e-17      0.5184139  0.9946666
Toussaint -3.061320       -0.3438710  1.998623e-16      0.8940186  0.9946666
Glucksman -5.634212       -0.6328782 -2.402223e-16      0.6528249  0.9946666
               p.value
Bardella  1.195536e-06
Autres    1.014019e-02
Aubry     4.600776e-02
Lassale   3.834629e-02
Toussaint 2.203638e-03
Glucksman 1.758601e-08

$`2`
                v.test Mean in category  Overall mean sd in category Overall sd
Lassale       7.154761        1.4661725 -5.321357e-17      0.9969633  0.9946666
Deffontaines  4.305462        0.8822865 -2.591382e-16      0.9603597  0.9946666
Glucksman     3.618697        0.7415528 -2.402223e-16      0.6752959  0.9946666
Autres       -2.060698       -0.4222837  1.597422e-16      0.6296755  0.9946666
Hayer        -2.827635       -0.5794463  1.139935e-16      0.6432678  0.9946666
Bellamy      -3.127869       -0.6409711  2.218785e-16      0.7926806  0.9946666
                  p.value
Lassale      8.381854e-13
Deffontaines 1.666377e-05
Glucksman    2.960904e-04
Autres       3.933184e-02
Hayer        4.689329e-03
Bellamy      1.760786e-03

$`3`
             v.test Mean in category  Overall mean sd in category Overall sd
Hayer      6.107688        1.2944446  1.139935e-16      0.8588588  0.9946666
Glucksman  3.630919        0.7695258 -2.402223e-16      0.7456890  0.9946666
Toussaint  3.464445        0.7342438  1.998623e-16      0.8697713  0.9946666
Bardella  -2.659573       -0.5636617  1.699660e-17      0.5241394  0.9946666
Marechal  -3.550099       -0.7523970 -4.907791e-16      0.5509129  0.9946666
               p.value
Hayer     1.010846e-09
Glucksman 2.824138e-04
Toussaint 5.313271e-04
Bardella  7.823979e-03
Marechal  3.850864e-04

$`4`
            v.test Mean in category  Overall mean sd in category Overall sd
Marechal  6.005817        2.3723232 -4.907791e-16      1.4186611  0.9946666
Hayer    -2.188212       -0.8643529  1.139935e-16      0.3171995  0.9946666
              p.value
Marechal 1.903712e-09
Hayer    2.865419e-02

$`5`
            v.test Mean in category  Overall mean sd in category Overall sd
Aubry     7.204488        3.1350842 -3.912355e-18      1.7868040  0.9946666
Autres    1.991475        0.8666046  1.597422e-16      0.8657687  0.9946666
Lassale  -2.731904       -1.1888073 -5.321357e-17      0.1327097  0.9946666
Bardella -3.071960       -1.3367852  1.699660e-17      0.8308688  0.9946666
              p.value
Aubry    5.826231e-13
Autres   4.642866e-02
Lassale  6.296956e-03
Bardella 2.126582e-03

$`6`
                v.test Mean in category  Overall mean sd in category Overall sd
Bellamy       4.738760         2.691912  2.218785e-16      0.4723836  0.9946666
Toussaint     3.396640         1.929504  1.998623e-16      1.2960162  0.9946666
Hayer         3.188246         1.811123  1.139935e-16      0.3056362  0.9946666
Aubry         2.648522         1.504526 -3.912355e-18      0.3961354  0.9946666
Glucksman     2.595190         1.474230 -2.402223e-16      1.2187502  0.9946666
Marechal      2.133428         1.211920 -4.907791e-16      0.4469218  0.9946666
Autres       -2.248256        -1.277150  1.597422e-16      1.5834342  0.9946666
Deffontaines -2.341440        -1.330085 -2.591382e-16      0.1099219  0.9946666
Lassale      -2.358849        -1.339974 -5.321357e-17      0.1345288  0.9946666
Bardella     -4.676753        -2.656688  1.699660e-17      0.6622527  0.9946666
                  p.value
Bellamy      2.150304e-06
Toussaint    6.821870e-04
Hayer        1.431388e-03
Aubry        8.084470e-03
Glucksman    9.453863e-03
Marechal     3.288966e-02
Autres       2.455986e-02
Deffontaines 1.920949e-02
Lassale      1.833171e-02
Bardella     2.914534e-06

Commentaire : La méthode SKATER met en évidence … régions ayant les caractéristiques suivantes
- La région 1 ( …)
- La région 2 (…) .
- la région 3 (…)
- …

D. ZOOM SUR UNE REGION : CLASSIFICATION

Nous allons finalement reprendre les analyses précédentes mais en nous limitant à une seule région et en passant à l’échelle plus détaillée des circonscriptions.Commençons par la classification

Préparation des données

### Fonds de carte
map<-st_read("data/elect2024/map_circ.shp", quiet=T)  %>%
    filter(nom_reg %in% myreg) %>%
      select(code=ID,  geometry) %>%
      st_transform(2154)

### Données
don<-readRDS("data/elect2024/don_circ.RDS") %>%
          filter(nom_reg %in% myreg) %>%
          select(code=ID, nom=ID, 10:17,19,20)


### Jointure
mapdon<-left_join(map[,1],don)

Cartographie rapide

Un coup d’oeil rapide sur la distribution des votes …

plot(mapdon[3:12])

Analyse en composantes principales

On utilise la même procédure que pour les régions

tab<-mapdon[,3:12] %>% st_drop_geometry()
row.names(tab)<- mapdon$code
acp<-PCA(tab,  scale.unit = T)

summary(acp)


Call:
PCA(X = tab, scale.unit = T) 


Eigenvalues
                       Dim.1   Dim.2   Dim.3   Dim.4   Dim.5   Dim.6   Dim.7
Variance               4.706   1.975   1.736   0.677   0.419   0.227   0.136
% of var.             47.063  19.754  17.359   6.772   4.188   2.270   1.356
Cumulative % of var.  47.063  66.817  84.175  90.947  95.135  97.405  98.761
                       Dim.8   Dim.9  Dim.10
Variance               0.083   0.041   0.000
% of var.              0.828   0.410   0.000
Cumulative % of var.  99.590 100.000 100.000

Individuals (the 10 first)
                 Dist    Dim.1    ctr   cos2    Dim.2    ctr   cos2    Dim.3
09001        |  3.846 |  0.739  0.237  0.037 |  1.111  1.275  0.083 | -3.428
09002        |  2.653 | -0.704  0.215  0.070 |  0.763  0.602  0.083 | -2.044
11001        |  2.528 | -2.092  1.898  0.685 |  0.082  0.007  0.001 | -1.114
11002        |  2.498 | -2.320  2.334  0.863 | -0.384  0.152  0.024 | -0.118
11003        |  2.280 | -0.673  0.196  0.087 |  0.158  0.026  0.005 | -1.328
12001        |  4.743 |  1.128  0.552  0.057 |  1.815  3.403  0.146 |  4.138
12002        |  2.673 |  0.584  0.148  0.048 |  2.322  5.571  0.755 |  0.683
12003        |  3.187 |  0.523  0.119  0.027 |  2.549  6.710  0.640 |  1.350
34006        |  4.357 | -3.758  6.123  0.744 | -1.684  2.930  0.149 |  1.136
31002        |  3.555 |  3.347  4.859  0.887 | -0.774  0.618  0.047 |  0.731
                ctr   cos2  
09001        13.815  0.794 |
09002         4.912  0.593 |
11001         1.460  0.194 |
11002         0.016  0.002 |
11003         2.072  0.339 |
12001        20.127  0.761 |
12002         0.548  0.065 |
12003         2.143  0.180 |
34006         1.518  0.068 |
31002         0.628  0.042 |

Variables
                Dim.1    ctr   cos2    Dim.2    ctr   cos2    Dim.3    ctr
Aubry        |  0.612  7.951  0.374 | -0.676 23.112  0.457 | -0.213  2.613
Bardella     | -0.977 20.274  0.954 | -0.054  0.147  0.003 | -0.025  0.035
Bellamy      |  0.446  4.222  0.199 |  0.214  2.314  0.046 |  0.798 36.723
Deffontaines | -0.417  3.687  0.174 |  0.429  9.312  0.184 | -0.489 13.748
Glucksman    |  0.935 18.593  0.875 |  0.185  1.741  0.034 | -0.156  1.403
Hayer        |  0.650  8.966  0.422 |  0.272  3.743  0.074 |  0.588 19.944
Lassale      | -0.091  0.178  0.008 |  0.924 43.218  0.854 |  0.013  0.010
Marechal     | -0.699 10.385  0.489 | -0.475 11.405  0.225 |  0.409  9.637
Toussaint    |  0.934 18.531  0.872 | -0.268  3.623  0.072 | -0.110  0.702
Autres       |  0.583  7.213  0.339 |  0.165  1.385  0.027 | -0.513 15.186
               cos2  
Aubry         0.045 |
Bardella      0.001 |
Bellamy       0.637 |
Deffontaines  0.239 |
Glucksman     0.024 |
Hayer         0.346 |
Lassale       0.000 |
Marechal      0.167 |
Toussaint     0.012 |
Autres        0.264 |

Commentaires : Les axes sont ils différents de ceux vus pour la France entière par départements ?
- L’axe 1 résume … % de l’information et oppose les régons … aux régions …
- L’axe 2 résume … % de l’information et oppose les régons … aux régions …

Qeu montrent les cartes

mapdon$axe1<-acp$ind$coord[,1]
mapdon$axe2<-acp$ind$coord[,2]

par(mfrow=c(1,2))
mypal<- brewer.pal(6, "RdYlBu")
mybreaks<-c(-10,-2,-1,0,1,2,10)

mf_map(mapdon, type="choro", var="axe1", pal=mypal, breaks=mybreaks, lwd=0.1, border="white")
mf_map(mapreg, type="base", col=NA, lwd=1, add=T)
mf_layout("Axe1 (...%): Sigification ?", frame=T)

mf_map(mapdon, type="choro", var="axe2",pal=mypal, breaks=mybreaks, lwd=0.1, border="white")
mf_map(mapreg, type="base", col=NA, lwd=1, add=T)
mf_layout("Axe2 (..%) : Signification ?", frame=T)

Classification ascendante hiérarchique

On applique ensuite une méthode de classification où vous devrez choisir le bon nombre de classes

cah<-HCPC(acp, nb.clust = 3, graph=F)
plot(cah,choice = "tree")

catdes(cah$data.clust,num.var = 11)


Link between the cluster variable and the quantitative variables
================================================================
                  Eta2      P-value
Bardella     0.7635263 3.953724e-15
Toussaint    0.7559937 8.132471e-15
Glucksman    0.7279219 9.953003e-14
Lassale      0.7009854 8.728184e-13
Marechal     0.5105046 7.315055e-08
Aubry        0.5000834 1.187528e-07
Hayer        0.4077475 5.856781e-06
Bellamy      0.2244642 2.889636e-03
Autres       0.2118850 4.183704e-03
Deffontaines 0.2068348 4.845779e-03

Description of each cluster by quantitative variables
=====================================================
$`1`
             v.test Mean in category Overall mean sd in category Overall sd
Bardella   5.165357        40.208105    33.202060      4.1690321  8.1381156
Marechal   4.947902         6.109378     5.500267      0.5431260  0.7386298
Autres    -2.688677         6.770671     7.007183      0.5583550  0.5277966
Lassale   -2.819601         2.839666     3.964720      1.2829173  2.3940711
Bellamy   -3.212684         4.861061     5.489652      0.5917467  1.1739557
Toussaint -3.763994         3.989570     5.190898      0.9349410  1.9149785
Hayer     -4.109525        10.927318    12.137259      0.8526189  1.7665413
Glucksman -5.349656        12.881743    15.607179      1.7289872  3.0567601
               p.value
Bardella  2.399804e-07
Marechal  7.501762e-07
Autres    7.173574e-03
Lassale   4.808336e-03
Bellamy   1.315008e-03
Toussaint 1.672211e-04
Hayer     3.964738e-05
Glucksman 8.812178e-08

$`2`
            v.test Mean in category Overall mean sd in category Overall sd
Lassale   5.669423         6.535707     3.964720      1.5700410  2.3940711
Aubry    -2.927163         7.094251     9.218785      1.4671845  3.8317130
Marechal -3.377848         5.027670     5.500267      0.4389363  0.7386298
              p.value
Lassale  1.432793e-08
Aubry    3.420701e-03
Marechal 7.305532e-04

$`3`
                v.test Mean in category Overall mean sd in category Overall sd
Toussaint     5.877463         8.399128     5.190898      1.4098687  1.9149785
Aubry         4.754040        14.411178     9.218785      4.6440868  3.8317130
Glucksman     4.605575        19.620066    15.607179      1.5264840  3.0567601
Hayer         3.274420        13.786067    12.137259      1.2626467  1.7665413
Autres        2.720433         7.416459     7.007183      0.2434638  0.5277966
Bellamy       2.013699         6.163494     5.489652      0.6615278  1.1739557
Marechal     -2.035031         5.071808     5.500267      0.5850698  0.7386298
Deffontaines -3.150424         2.066903     2.681996      0.1197292  0.6849521
Lassale      -3.319331         1.699558     3.964720      0.7101750  2.3940711
Bardella     -5.102650        21.365341    33.202060      4.9060553  8.1381156
                  p.value
Toussaint    4.166028e-09
Aubry        1.993912e-06
Glucksman    4.113275e-06
Hayer        1.058791e-03
Autres       6.519649e-03
Bellamy      4.404115e-02
Marechal     4.184780e-02
Deffontaines 1.630339e-03
Lassale      9.023326e-04
Bardella     3.349294e-07

Commentaire : La classification met en évidence combien de types de région?
- La classe 1 ( …)
- La classe 2 (…) .
- la classe 3 (…)
- …

On peut ensuite cartogaphier les classes correspondantes pour mieux voir la distribution spatiale. Cela suppose que l’on ait donné aux classes des noms suite à l’interprétation

mapdon$cah<-as.factor(cah$data.clust$clust)
levels(mapdon$cah)<-c("Classe 1 : ????", 
                      "Classe 2 = ????",
                      "Classe 3 = ???? ")


par(mfrow=c(1,1))

mf_map(mapdon, type="typo", var="cah", lwd=0.1, border="white", leg_title = "Classes")
mf_map(mapreg, type="base", col=NA, lwd=1, add=T)
mf_layout("Typologie en trois classes ...", frame=T,credits = "")

Commentaire : …

E. ZOOM SUR UNE REGION : REGIONALISATION

Nous reprenons la méthode utilisée pour la France par département, mais en l’appliquant aux circonscriptions de notre région

Préparation des données

la préparation des données est la même que précédemment

### Fonds de carte région (pour habillage)
mapdep<-st_read("data/elect2024/map_dept.shp", quiet=T) %>%
      st_transform(2154)

### Fonds de carte
map<-st_read("data/elect2024/map_circ.shp", quiet=T)  %>%
    filter(nom_reg %in% myreg) %>%
      select(code=ID,  geometry) %>%
      st_transform(2154)

### Données
don<-readRDS("data/elect2024/don_circ.RDS") %>%
          filter(nom_reg %in% myreg) %>%
          select(code=ID, nom=ID, 10:17,19,20)


### Jointure
mapdon<-left_join(map[,1],don)

Calcul du graphe de contiguïté

On utilise la procédure poly2nb() du package spdep :

# Table de voisinage
map_nb<-spdep::poly2nb(mapdon,row.names = mapdon$code)

# Table de poids
map_nb_w<-nb2listw(map_nb)
summary(map_nb_w)

Characteristics of weights list object:
Neighbour list object:
Number of regions: 49 
Number of nonzero links: 236 
Percentage nonzero weights: 9.829238 
Average number of links: 4.816327 
Link number distribution:

 2  3  4  5  6  7  8 
 1 12  9  9 12  3  3 
1 least connected region:
65002 with 2 links
3 most connected regions:
31006 34005 81003 with 8 links

Weights style: W 
Weights constants summary:
   n   nn S0       S1       S2
W 49 2401 49 21.72266 200.6484

# Carte de voisinage
coo<-st_coordinates(st_centroid(mapdon))
mf_map(mapdon, type="base",col="lightyellow")
mf_layout("Carte des liens de voisinage", frame=T)
plot.nb(map_nb,coords = coo,add = T,col = "red",points = F)
mf_label(mapdon, var="code", col="blue",cex=0.6,halo = T, bg="white",r = 0.1)

Commentaire : On vérifie que le graphe est connexe et que chaque département a au moins un voisin. Certains départements situes aux extrémités du pays ont un seul voisin (ex. O6 Alpes Maritime ou 09 Finistère) tandis que d’autres ont jusqu’à 10 voisins (77 : Seine-et-Marne). Leurs possibilités de regroupement en région seront donc plus ou moins contraintes.

Calcul de la matrice de dissimilarité

Nous devons calculer la matrice de dissimilarité directement à partir du tableau des variables standardisées.

# choix des variables
tab<-mapdon[,3:12] %>% st_drop_geometry()
row.names(tab)<- mapdon$code

# standardisation
tabstd <-scale(tab)

# calcul des distances
matdis <- as.matrix(dist(tabstd, method="euclidean"))

Calcul de l’arbre couvrant minimal (minimum spanning tree)

map_nb<-poly2nb(mapdon)
lcosts <- nbcosts(map_nb,tabstd,method="euclidean",)
#summary(lcosts)
sim <- nb2listw(map_nb,lcosts,style="B")
#summary(sim)
mst <- mstree(sim)
size<-mst[,3]
size<-size/max(size)
mst[,3]<-0.5+4*size


y<-unlist(sim$neighbours)
w<-unlist(sim$weights)
x<-as.numeric(lapply(sim$neighbours, length))
n<-length(x)
xx<-NULL
for (i in 1:n) {
  z<-rep(i,x[i])
  xx<-c(xx,z)
}


q<-data.frame(xx,y,w)

ctr<-st_coordinates(st_centroid(mapdon))

mf_map(mapdon, type="base",col="lightyellow",lwd=0.2)
mf_map(mapdep, type="base", col=NA, lwd=1, add=T)
#segments(ctr[q[,1],1] ,ctr[q[,1],2], ctr[q[,2],1] ,ctr[q[,2],2],
#         col="gray", lwd=1+2*q$w, lty=2)
segments(ctr[mst[,1],1] ,ctr[mst[,1],2], ctr[mst[,2],1] ,ctr[mst[,2],2],
         col="red", lwd=mst[,3])

#points(x=(ctr[q[,1],1] +ctr[q[,2],1])/2,  y=(ctr[q[,1],2] +ctr[q[,2],2])/2,   pch=22, # bg="white", cex=3, col="black")
#text(  x=(ctr[q[,1],1] +ctr[q[,2],1])/2,  y=(ctr[q[,1],2] +ctr[q[,2],2])/2, #round(q$w,1), cex=0.7)
mf_label(mapdon, var="code", col="blue",cex=0.5,halo = T,bg = "white")
mf_layout("Arbre couvrant minimum du graphe de dissimilarité", frame=T)

Commentaire : Que remarquez-vous ?

Régionalisation par la méthode SKATER

A vous de choisir le bon nombre de régions…

contig_w<-queen_weights(mapdon)
regio<-skater(6, contig_w, tab, scale_method = "standardize")


mapdon$regio<-as.factor(regio$Clusters)
don$regio<-as.factor(regio$Clusters)

mf_map(mapdon, type="typo",var="regio",leg_title = "Regionalisation", lwd=0.4, border="white")
mf_map(mapdep, type="base", col=NA, lwd=1, add=T)
segments(ctr[mst[,1],1] ,ctr[mst[,1],2], ctr[mst[,2],1] ,ctr[mst[,2],2],
         col="red", lwd=mst[,3])
#mstk<-mst[c(2:5,7:10),]
#segments(ctr[mstk[,1],1] ,ctr[mstk[,1],2], ctr[mstk[,2],1] ,ctr[mstk[,2],2],
#         col="red", lwd=1+2*mstk[,3])
#mf_label(mapdon, var="nom", col="black",cex=0.5,halo = T,bg = "white")
mf_layout("Régionalisation par la methode SKATER", frame=T)

Commentaire : Quelles différences avec la classification ?

regio

$Clusters
 [1] 2 2 1 1 2 3 3 3 1 4 4 1 1 4 1 1 6 6 2 4 2 2 4 2 2 1 1 1 3 3 3 2 2 1 1 1 1 4
[39] 3 2 3 2 2 4 1 5 5 1 1

$`Total sum of squares`
[1] 480

$`Within-cluster sum of squares`
 [1] 22.05654 12.00617 17.29510 19.21094 12.59450 24.02348 10.53002 22.60925
 [9] 11.66837 34.23028

$`Total within-cluster sum of squares`
[1] 293.7753

$`The ratio of between to total sum of squares`
[1] 0.612032

Commentaire : Quelle est la qualité de la régionalisation ?

Profil de vote des régions issues de SKATER

tabstd<-as.data.frame(tabstd)
tabstd$regions<-as.factor(regio$Clusters)

catdes(tabstd,num.var = 11)


Link between the cluster variable and the quantitative variables
================================================================
                  Eta2      P-value
Lassale      0.7806245 3.927220e-13
Toussaint    0.7569089 3.416904e-12
Bardella     0.7498714 6.228452e-12
Glucksman    0.7376145 1.702063e-11
Bellamy      0.6396853 1.275197e-08
Deffontaines 0.5997722 1.115625e-07
Aubry        0.5404888 1.882237e-06
Marechal     0.5289739 3.110908e-06
Hayer        0.4995109 1.059797e-05
Autres       0.2868691 1.025983e-02

Description of each cluster by quantitative variables
=====================================================
$`1`
             v.test Mean in category  Overall mean sd in category Overall sd
Marechal   4.850801        0.9507492 -1.793138e-16      0.7205390  0.9897433
Bardella   4.218524        0.8268239 -2.492603e-16      0.6010402  0.9897433
Bellamy   -2.493796       -0.4887801  2.987973e-16      0.4755723  0.9897433
Hayer     -2.610644       -0.5116820 -3.089932e-16      0.5400064  0.9897433
Autres    -2.852440       -0.5590736 -5.048222e-16      1.0658564  0.9897433
Toussaint -2.908375       -0.5700369  8.135499e-17      0.5714399  0.9897433
Lassale   -3.485603       -0.6831725  4.814743e-17      0.3677431  0.9897433
Glucksman -4.550217       -0.8918352  7.448690e-17      0.5773489  0.9897433
               p.value
Marechal  1.229636e-06
Bardella  2.459068e-05
Bellamy   1.263850e-02
Hayer     9.037196e-03
Autres    4.338504e-03
Toussaint 3.633119e-03
Lassale   4.910296e-04
Glucksman 5.359054e-06

$`2`
           v.test Mean in category Overall mean sd in category Overall sd
Lassale  3.469376        0.8247701 4.814743e-17      0.6134112  0.9897433
Aubry   -2.071237       -0.4923924 2.297270e-16      0.4231931  0.9897433
Bellamy -2.218756       -0.5274619 2.987973e-16      0.8023645  0.9897433
             p.value
Lassale 0.0005216689
Aubry   0.0383366589
Bellamy 0.0265033208

$`3`
           v.test Mean in category  Overall mean sd in category Overall sd
Bellamy  4.469216        1.4453741  2.987973e-16      0.6311409  0.9897433
Lassale  3.875329        1.2533072  4.814743e-17      0.5744634  0.9897433
Hayer    2.598313        0.8403116 -3.089932e-16      0.9161303  0.9897433
Aubry   -2.021208       -0.6536720  2.297270e-16      0.1781132  0.9897433
             p.value
Bellamy 7.850671e-06
Lassale 1.064805e-04
Hayer   9.368302e-03
Aubry   4.325826e-02

$`4`
                v.test Mean in category  Overall mean sd in category Overall sd
Toussaint     5.270502        1.8442915  8.135499e-17     0.67928508  0.9897433
Glucksman     4.425772        1.5486975  7.448690e-17     0.15470495  0.9897433
Hayer         3.348557        1.1717509 -3.089932e-16     0.55050264  0.9897433
Aubry         3.196516        1.1185476  2.297270e-16     1.01281298  0.9897433
Autres        2.642443        0.9246623 -5.048222e-16     0.44958990  0.9897433
Bellamy       2.284201        0.7993039  2.987973e-16     0.37556096  0.9897433
Deffontaines -2.262611       -0.7917489  1.382822e-16     0.09093272  0.9897433
Lassale      -2.403146       -0.8409261  4.814743e-17     0.29332084  0.9897433
Marechal     -2.403756       -0.8411393 -1.793138e-16     0.36399037  0.9897433
Bardella     -4.519790       -1.5815969 -2.492603e-16     0.50541886  0.9897433
                  p.value
Toussaint    1.360512e-07
Glucksman    9.609809e-06
Hayer        8.123351e-04
Aubry        1.390981e-03
Autres       8.231043e-03
Bellamy      2.235972e-02
Deffontaines 2.365968e-02
Lassale      1.625468e-02
Marechal     1.622761e-02
Bardella     6.190109e-06

$`5`
             v.test Mean in category  Overall mean sd in category Overall sd
Aubry      3.320684         2.299659  2.297270e-16      1.5647360  0.9897433
Toussaint  2.308076         1.598402  8.135499e-17      0.4633838  0.9897433
Bardella  -2.072268        -1.435099 -2.492603e-16      0.5743849  0.9897433
               p.value
Aubry     0.0008979727
Toussaint 0.0209948920
Bardella  0.0382404927

$`6`
               v.test Mean in category Overall mean sd in category Overall sd
Deffontaines 4.719854          3.26862 1.382822e-16      0.2199139  0.9897433
                  p.value
Deffontaines 2.360139e-06

Commentaire : La méthode SKATER met en évidence … régions ayant les caractéristiques suivantes
- La région 1 ( …)
- La région 2 (…) .
- la région 3 (…)
- …